home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / tk.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  2.5 KB  |  81 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the tk command.
  2. # It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1997 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # SCCS: @(#) tk.test 1.3 97/05/20 15:17:44
  10.  
  11. if {[info commands test] == ""} {
  12.     source defs
  13. }
  14.  
  15. test tk-1.1 {tk command: general} {
  16.     list [catch {tk} msg] $msg
  17. } {1 {wrong # args: should be "tk option ?arg?"}}
  18. test tk-1.2 {tk command: general} {
  19.     list [catch {tk xyz} msg] $msg
  20. } {1 {bad option "xyz": must be appname, or scaling}}
  21.  
  22. set appname [tk appname]
  23. test tk-2.1 {tk command: appname} {
  24.     list [catch {tk appname xyz abc} msg] $msg
  25. } {1 {wrong # args: should be "tk appname ?newName?"}}
  26. test tk-2.2 {tk command: appname} {
  27.     tk appname foobazgarply
  28. } {foobazgarply}
  29. test tk-2.3 {tk command: appname} {unixOnly} {
  30.     tk appname bazfoogarply
  31.     expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
  32. } {1}
  33. test tk-2.4 {tk command: appname} {
  34.     tk appname $appname
  35. } $appname
  36. tk appname $appname
  37.     
  38. set scaling [tk scaling]
  39. test tk-3.1 {tk command: scaling} {
  40.     list [catch {tk scaling -displayof} msg] $msg
  41. } {1 {value for "-displayof" missing}}
  42. test tk-3.2 {tk command: scaling: get current} {
  43.     tk scaling 1
  44.     format %.2g [tk scaling]
  45. } 1
  46. test tk-3.3 {tk command: scaling: get current} {
  47.     tk scaling -displayof . 1.25
  48.     format %.3g [tk scaling]
  49. } 1.25
  50. test tk-3.4 {tk command: scaling: set new} {
  51.     list [catch {tk scaling xyz} msg] $msg
  52. } {1 {expected floating-point number but got "xyz"}}
  53. test tk-3.5 {tk command: scaling: set new} {
  54.     list [catch {tk scaling -displayof . xyz} msg] $msg
  55. } {1 {expected floating-point number but got "xyz"}}
  56. test tk-3.6 {tk command: scaling: set new} {
  57.     tk scaling 1
  58.     format %.2g [tk scaling]
  59. } 1
  60. test tk-3.7 {tk command: scaling: set new} {
  61.     tk scaling -displayof . 1.25
  62.     format %.3g [tk scaling]
  63. } 1.25
  64. test tk-3.8 {tk command: scaling: negative} {
  65.     tk scaling -1
  66.     expr {[tk scaling] > 0}
  67. } {1}
  68. test tk-3.9 {tk command: scaling: too big} {
  69.     tk scaling 1000000
  70.     expr {[tk scaling] < 10000}
  71. } {1}    
  72. test tk-3.10 {tk command: scaling: widthmm} {
  73.     tk scaling 1.25
  74.     expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
  75. } {0}
  76. test tk-3.11 {tk command: scaling: heightmm} {
  77.     tk scaling 1.25
  78.     expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
  79. } {0}
  80. tk scaling $scaling
  81.